home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0635.ZIP / MGPROG.INC < prev    next >
Text File  |  1987-10-25  |  29KB  |  1,109 lines
  1.  
  2. {  ** Start of MGPROG.INC **
  3. Author : Eric H. Snyder
  4.          1417 Evergreen
  5.          Homewood, IL  60430
  6.  
  7. Note   : The user must declare the number of windows in the program
  8.          as follows;
  9.          Const
  10.            ScreenCount = N;      Where N = the # of windows being defined.
  11. }
  12.  
  13. Type
  14.   MG_CharPtr        =  ^Char;
  15.   MG_ExitsTyp       =  Set of Byte;
  16.   MG_Str80          =  String[80];
  17.   MG_Str255         =  String[255];
  18.   MG_ScreenImage    =  array[1..25,1..80] of integer;
  19.   MG_ScreenDef      =  Record
  20.                          X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol : Byte;
  21.                        End;
  22.  
  23.   MG_SavedScreen    = ^MG_SavedScreenRec;
  24.   MG_SavedScreenRec =  Record
  25.                          BackLink        : MG_SavedScreen;
  26.                          XLoc,Yloc       : Integer;
  27.                          ScreenStats     : MG_ScreenDef;
  28.                          MG_SavedWindow  : MG_CharPtr;
  29.                        End;
  30.  
  31.   MG_ScreenObjLLPtr = ^MG_ScreenObjLLTyp;
  32.   MG_ScreenObjLLTyp =  Record
  33.                          LLForward : MG_ScreenObjLLPtr;
  34.                          LLWindow  : Byte;
  35.                          LLTyp     : Char;
  36.                          LLCol, LLRow, LLAtr, LLlen : Integer;
  37.                          LLTxt     : MG_Str80;
  38.                        End;
  39.  
  40.   MG_Regs       = Record
  41.                     AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
  42.                   End;
  43.  
  44.   MG_FrameChars = Record
  45.                     TL,TR,BL,BR,HC,VC : Char;
  46.                    End;
  47.  
  48. Const           { Delete unused frame character constant records }
  49.   MG_LastOpened  : MG_ScreenDef = (X1:0;Y1:0;X2:81;Y2:26;BgCol:0;FrameTyp:0;FrCol:0);
  50.   MG_FirstScreen : Boolean = True;
  51.   MG_TimeOut     : Integer = 300;
  52.  
  53. Var
  54.   MG_PhysicalScreen      : MG_CharPtr;
  55.   MG_CurrentScreen,
  56.   MG_NewScreen           :  MG_SavedScreen;
  57.   MG_DefinedScreens      :  Array[1..ScreenCount] of MG_ScreenDef;
  58.   UpperByte,LowerByte    :  Byte;                   { Used                    }
  59.   UpperInt,LowerInt      :  Integer;                {      in range           }
  60.   UpperReal,LowerReal    :  Real;                   {               checking  }
  61.   UserEditSet            :  Set of Char;            { User declared char set  }
  62.   MG_Registers           :  MG_Regs;
  63.   MG_ScreenType          :  Char;
  64.   MG_ScreenObjLL         :  MG_ScreenObjLLPtr;
  65.   MG_ScreenLLBase        :  MG_ScreenObjLLPtr;
  66.   MG_RiteFlag            :  Array[1..ScreenCount] of Boolean;
  67.  
  68. Procedure InitializeScreens;
  69. Var
  70.   I : Integer;
  71. Begin
  72. MG_ScreenLLBase := Nil;
  73. For I := 1 to ScreenCount do
  74.   MG_RiteFlag[I] := False;
  75. MG_TimeOut := 300;
  76. Intr($11,MG_Registers);
  77. If (Lo(MG_Registers.AX) and $30 = $30) then
  78.   Begin
  79.   MG_PhysicalScreen    := Ptr($B000,$0000);
  80.   MG_ScreenType        := 'M';
  81.   End
  82. Else
  83.   Begin
  84.   MG_PhysicalScreen    := Ptr($B800,$0000);
  85.   MG_ScreenType        := 'C';
  86.   End;
  87. End; {InitScreen}
  88.  
  89. Procedure CharOut(ScrOfs,Ch:Integer;Attr:Byte);
  90. Begin
  91. Mem[Seg(MG_PhysicalScreen^):(Ofs(MG_PhysicalScreen^) + ScrOfs)]     := Ch;
  92. Mem[Seg(MG_PhysicalScreen^):(Ofs(MG_PhysicalScreen^) + ScrOfs + 1)] := Attr;
  93. End; {CharOut}
  94.  
  95. Procedure Rite(S:MG_Str80;Col,Row:Integer;Attr:Byte);
  96. Var
  97.   I,ScrOfs : Integer;
  98. Begin
  99. Row := (Row - 1) * 160;
  100. For I := 1 to Length(S) do
  101.   Begin
  102.   ScrOfs := Row + ((Col + I - 2) * 2);
  103.   CharOut(ScrOfs,Ord(S[I]),Attr);
  104.   End;
  105. End; {Rite}
  106.  
  107. Procedure WinRite(S:MG_Str80;X,Y:Byte;Attr:Integer);
  108. Begin
  109. With MG_LastOpened do
  110.   Begin
  111.   X := X + X1;
  112.   Y := Y + Y1;
  113.   End;
  114. Rite(S,X,Y,Attr);
  115. End; {WinRite}
  116.  
  117. Procedure DefineScreen(Ind,dfX1,dfY1,dfX2,dfY2,dfBgCol,dfFrameTyp,dfFrCol:Byte);
  118. Begin
  119. With MG_DefinedScreens[Ind] do
  120.   Begin
  121.   X1       := dfX1;
  122.   Y1       := dfY1;
  123.   X2       := dfX2;
  124.   Y2       := dfY2;
  125.   BgCol    := dfBgCol;
  126.   FrameTyp := dfFrameTyp;
  127.   FrCol    := dfFrCol;
  128.   End;
  129. End;
  130.  
  131. Procedure MakeFrame(X1,Y1,X2,Y2,BgCol,Border,LinAttr : Integer);
  132. Type
  133.   BorderCharacters = Array[1..8] of Integer;
  134. Const
  135.   BorderTypes : Array[1..8] of BorderCharacters =
  136.                   (
  137.                   (218,196,191,179,179,192,196,217),
  138.                   (201,205,187,186,186,200,205,188),
  139.                   (213,205,184,179,179,212,205,190),
  140.                   (214,196,183,186,186,211,196,189),
  141.                   (194,196,194,179,179,192,196,217),
  142.                   (203,205,203,186,186,200,205,188),
  143.                   (209,205,209,179,179,212,205,190),
  144.                   (210,196,210,186,186,211,196,189)
  145.                   );
  146. Var
  147.   LLHoriz,LLVert : Integer;
  148.   TLCorner       : Integer;
  149.   THLine         : Integer;
  150.   TRCorner       : Integer;
  151.   LVLine         : Integer;
  152.   RVLine         : Integer;
  153.   BLCorner       : Integer;
  154.   BHLine         : Integer;
  155.   BRCorner       : Integer;
  156.  
  157. Procedure BorderLine(Row,Col,Num,Ch,Direction,Attr : Integer);
  158. Var
  159.   I,ScrOfs : Integer;
  160. Begin
  161. ScrOfs := ((Row - 1) * 160) + ((Col - 1) * 2);
  162. For I := 1 to Num do
  163.   Begin
  164.   CharOut(ScrOfs,Ch,Attr);
  165.   If Direction = 0 then
  166.     ScrOfs := ScrOfs + 160
  167.   Else
  168.     ScrOfs := ScrOfs + 2;
  169.   End;
  170. End; {BorderLine}
  171.  
  172. Begin
  173. Window(X1,Y1,X2,Y2);
  174. TextBackground(BgCol);
  175. ClrScr;
  176. LLHoriz   := X2 - X1 + 1;
  177. LLVert    := Y2 - Y1 + 1;
  178. TLCorner  := BorderTypes[Border,1];
  179. THLine    := BorderTypes[Border,2];
  180. TRCorner  := BorderTypes[Border,3];
  181. LVLine    := BorderTypes[Border,4];
  182. RVLine    := BorderTypes[Border,5];
  183. BLCorner  := BorderTypes[Border,6];
  184. BHLine    := BorderTypes[Border,7];
  185. BRCorner  := BorderTypes[Border,8];
  186. CharOut( (((Y1 - 1) * 160) + ((X1 - 1) * 2)),TLCorner,LinAttr);
  187. BorderLine(Y1,(X1 + 1),(LLHoriz - 2),THLine,1,LinAttr);
  188. CharOut( (((Y1 - 1) * 160) + ((X2 - 1) * 2)),TRCorner,LinAttr);
  189. BorderLine((Y1 + 1),X1,(LLVert - 2),LVLine,0,LinAttr);
  190. BorderLine((Y1 + 1),X2,(LLVert - 2),RVLine,0,LinAttr);
  191. CharOut( (((Y2 - 1) * 160) + ((X1 - 1) * 2)),BLCorner,LinAttr);
  192. BorderLine(Y2,(X1 + 1),(LLHoriz - 2),BHLine,1,LinAttr);
  193. CharOut( (((Y2 - 1) * 160) + ((X2 - 1) * 2)),BRCorner,LinAttr);
  194. Window((X1 + 1),(Y1 + 1),(X2 - 1),(Y2 - 1));
  195. GotoXY(1,1);
  196. End; {MakeFrame}
  197.  
  198. Procedure OpenWindow(Ind:Byte);
  199.  
  200. Var
  201.   SD      : MG_ScreenDef;
  202.   LLObj   : MG_ScreenObjLLPtr;
  203.   WorkStr : MG_Str80;
  204.   I,J     : Integer;
  205.  
  206. Function SaveWindowContents(X1,Y1,X2,Y2 : Integer):MG_CharPtr;
  207.  
  208. Var
  209.   I,J     : Integer;
  210.   LLHoriz,LLVert : Integer;
  211.   Width   : Integer;
  212.   MovePtr : MG_CharPtr;
  213.  
  214. Begin
  215. LLHoriz := X2 - X1 + 1;
  216. LLVert  := Y2 - Y1 + 1;
  217. Width   := LLHoriz * 2;
  218. j       := ((Y1 - 1) * 160) + ((X1 - 1) * 2);
  219. GetMem(MovePtr,((LLHoriz * LLVert) * 2));
  220. SaveWindowContents := MovePtr;
  221. For I := 1 to LLVert do
  222.   Begin
  223.   Move(Mem[Seg(MG_PhysicalScreen^):(Ofs(MG_PhysicalScreen^) + J)],MovePtr^,Width);
  224.   J       := J + 160;
  225.   MovePtr := Ptr(Seg(MovePtr^),(Ofs(MovePtr^) + Width));
  226.   End;
  227. End; {SaveWindowContents}
  228.  
  229. Begin
  230. SD := MG_DefinedScreens[Ind];
  231. New(MG_NewScreen);
  232. With MG_NewScreen^ do
  233.   Begin
  234.   XLoc := WhereX;
  235.   YLoc := WhereY;
  236.   With SD do
  237.     MG_SavedWindow := SaveWindowContents(X1,Y1,X2,Y2);
  238.   ScreenStats := MG_LastOpened;
  239.   If MG_FirstScreen then
  240.     Begin
  241.     BackLink       := nil;
  242.     MG_FirstScreen := False;
  243.     End
  244.   Else
  245.     BackLink       := MG_CurrentScreen;
  246.   MG_CurrentScreen := MG_NewScreen
  247.   End;
  248. With SD do
  249.     MakeFrame(X1,Y1,X2,Y2,BgCol,FrameTyp,FrCol);
  250. MG_LastOpened := SD;
  251. If not MG_RiteFlag[Ind] then
  252.   Exit;
  253. LLObj := MG_ScreenLLBase;
  254. While (LLObj^.LLforward <> Nil) and
  255.       (LLObj^.LLWindow <> Ind)  do
  256.   LLObj := LLObj^.LLForward;
  257. If LLObj^.LLForward = Nil then
  258.   Exit;
  259. While (LLObj <> Nil) and
  260.       (LLObj^.LLWindow = Ind)   do
  261.   Begin
  262.   With LLObj^ do
  263.     Case LLTyp of
  264.   'T','H' : WinRite(LLTxt,LLCol,LLRow,LLAtr);
  265.       'F' : Begin
  266.             FillChar(WorkStr[1],LLlen,' ');
  267.             WorkStr[0] := Chr(Ord(LLlen));
  268.             WinRite(WorkStr,LLCol,LLRow,LLAtr);
  269.             End;
  270.       'V' : Begin
  271.             J := ((LLRow - 1) * 160) + ((LLCol - 1) * 2);
  272.             For I := 1 to Length(LLTxt) do
  273.               Begin
  274.               CharOut(J,Ord(LLTxt[I]),LLAtr);
  275.               J := J + 160;
  276.               End;
  277.             End;
  278.       End; {case}
  279.   LLObj := LLObj^.LLForward;
  280.   End;
  281. End; {OpenWindow}
  282.  
  283. Procedure CloseWindow;
  284.  
  285. Procedure  ReDisplayWindowContents(X1,Y1,X2,Y2 : Integer;
  286.                                        MovePtr : MG_CharPtr);
  287. Var
  288.   I,J     : Integer;
  289.   LLHoriz,LLVert : Integer;
  290.   Width   : Integer;
  291.   P       : MG_CharPtr;
  292.  
  293. Begin
  294. P       := MovePtr;
  295. LLHoriz := X2 - X1 + 1;
  296. LLVert  := Y2 - Y1 + 1;
  297. Width   := LLHoriz * 2;
  298. J       := ((Y1 - 1) * 160) + ((X1 - 1) * 2);
  299. For i := 1 to LLVert do
  300.   Begin
  301.   Move(MovePtr^,Mem[Seg(MG_PhysicalScreen^):(Ofs(MG_PhysicalScreen^) + J)],Width);
  302.   J       := J + 160;
  303.   MovePtr := Ptr(Seg(MovePtr^),(Ofs(MovePtr^) + Width));
  304.   End;
  305. FreeMem(P,((LLHoriz * LLVert)*2));
  306. End; {ReDisplayWindowContents}
  307.  
  308. Begin
  309. MG_NewScreen := MG_CurrentScreen;
  310. With MG_NewScreen^ do
  311.   Begin
  312.   With MG_LastOpened do
  313.     ReDisplayWindowContents(X1,Y1,X2,Y2,MG_SavedWindow);
  314.   With ScreenStats do
  315.     Window(X1+1,Y1+1,X2-1,Y2-1);
  316.   GotoXY(XLoc,YLoc);
  317.   MG_LastOpened    := ScreenStats;
  318.   MG_CurrentScreen := BackLink;
  319.   End;
  320. Dispose(MG_NewScreen);
  321. End; {CloseWindow}
  322.  
  323. Procedure CloseAllWindows;
  324. Begin
  325. While MG_CurrentScreen <> nil do
  326.   CloseWindow;
  327. End; {CloseAllWindows}
  328.  
  329. Procedure TerminateScreens;
  330. Var
  331.   LLBase,LLDispose : MG_ScreenObjLLPtr;
  332. Begin
  333. CloseAllWindows;
  334. LLBase := MG_ScreenLLBase;
  335. While LLBase <> nil do
  336.   Begin
  337.   LLDispose := LLBase;
  338.   LLBase    := LLBase^.LLForward;
  339.   Dispose(LLDispose);
  340.   End;
  341. End; {TerminateScreens}
  342.  
  343. {*******************************************************************}
  344. {** End of windowing routines **}{** Start of data entry routines **}
  345. {*******************************************************************}
  346.  
  347. Procedure MaxLimits;
  348. Begin
  349. LowerByte := 0;         UpperByte := 255;
  350. LowerInt  := -32767;    UpperInt  := MaxInt;
  351. LowerReal := 1E-38;     UpperReal := 1E+37;
  352. End; {MaxLimits}
  353.  
  354. Procedure ScreenSaver(TimeOut:Integer);
  355.  
  356. Type
  357.   RegPack = Record
  358.             AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
  359.             End;
  360.  
  361. Const
  362.   CrtModePort : array[0..1] of Integer = ($03B8,$03D8);
  363.  
  364. Var
  365.   Registers         : RegPack;
  366.   StartTime,EndTime : Integer;
  367.   ScreenBlanked     : Boolean;
  368.   Ch                : Char;
  369.   CrtModeByte       : Byte absolute $0040:$0065;
  370.   DisplayAdapter    : Integer;
  371.  
  372. Procedure GetTime(Var Time:Integer);
  373. Begin
  374. Registers.AX := $2C00;
  375. MSDos(Registers);
  376. Time := (Lo(Registers.CX) * 60) + Hi(Registers.DX);
  377. End; {GetTime}
  378.  
  379. Begin
  380. Case MG_ScreenType of
  381.   'M' : DisplayAdapter := 0;
  382.   'C' : DisplayAdapter := 1;
  383.   End;
  384. Repeat
  385.   ScreenBlanked := False;
  386.   GetTime(StartTime);
  387.   While not KeyPressed do
  388.     If not ScreenBlanked then
  389.       Begin
  390.       GetTime(EndTime);
  391.       If EndTime < StartTime then
  392.         EndTime := EndTime + 3600;
  393.       If ((EndTime - StartTime) >= TimeOut) then
  394.         Begin
  395.         ScreenBlanked := True;
  396.         Port[CrtModePort[DisplayAdapter]] := CrtModeByte and $F7;
  397.         End;
  398.        End;
  399.   If ScreenBlanked then
  400.     Begin
  401.     ScreenBlanked := False;
  402.     Port[CrtModePort[DisplayAdapter]] := CrtModeByte or $08;
  403.     While KeyPressed do
  404.       Read(kbd,Ch);
  405.     End;
  406. Until KeyPressed and not ScreenBlanked;
  407. End; {ScreenSaver}
  408.  
  409. Function EnterData(Var Variable;                { Variable being entered  }
  410.                          VarTyp     : Char;     { Indicated Variable type }
  411.                          XLoc,YLoc,             { X & Y Co-ordinates      }
  412.                          Len,                   { Length of field         }
  413.                          Decs,                  { No. of decimal places   }
  414.                          FieldAttr,
  415.                          CursorAttr : Byte;
  416.                          Exits      : MG_ExitsTyp):Integer; {Exits in addition to }
  417. Type                                                     { -1 : Param error    }
  418.   Edits = Set of Char;                                   {  0 : Typing out     }
  419.                                                          { 13 : Carriage Return}
  420.                                                          {-13 : ^M             }
  421. Const
  422.   BytIntEdits : Edits = ['0'..'9','+','-',' '];        {Pre-defined edit types}
  423.   RealEdits   : Edits = ['0'..'9','+','-','.','E',' '];
  424.   StrEditsAll : Edits = [' '..'}'];
  425.   Alpha       : Edits = ['A'..'Z','a'..'z',' '];
  426.   UpperCase   : Edits = ['A'..'Z',' '];
  427.   LowerCase   : Edits = ['a'..'z',' '];
  428.   Numeric     : Edits = ['0'..'9'];
  429.   Anything    : Edits = [#32..#254];
  430.   Date        : Edits = ['0'..'9','/'];
  431.   ClickOn     : Boolean = False;
  432.   InsertOn    : Boolean = False;
  433.  
  434. Var
  435.   BytVar     : Byte     absolute Variable;
  436.   IntVar     : Integer  absolute Variable;
  437.   RealVar    : Real     absolute Variable;
  438.   StrgVar    : MG_Str80 absolute Variable;
  439.   WorkStr    : MG_Str80;
  440.   OrigStr    : MG_Str80;
  441.   ValidChars : Edits;
  442.   Done       : Boolean;
  443.   Converted  : Boolean;
  444.   CtrlEmm    : Boolean;
  445.   CharIn     : Char;
  446.   Position   : Byte;
  447.  
  448. Procedure Beep;
  449. Begin
  450. Sound(800);
  451. Delay(50);
  452. Nosound;
  453. End; {Beep}
  454.  
  455. Procedure MakeClickNoise;
  456. Begin
  457. Sound(2000);
  458. Delay(5);
  459. NoSound;
  460. End; {ClickNoise}
  461.  
  462. Procedure RefreshDisplay;
  463. Var
  464.   TempStr   : MG_Str80;
  465.   WrkLen,I  : Integer;
  466.   Tail      : Char;
  467.  
  468. Begin
  469. TempStr := WorkStr;
  470. Tail := #95;
  471. If Done then
  472.   Tail := #32;
  473. For I := Length(WorkStr) + 1 to Len do
  474.   TempStr := Concat(TempStr,Tail);
  475. Rite (TempStr,XLoc,YLoc,FieldAttr);
  476. If not Converted then
  477.   CharOut(((YLoc-1)*160+(XLoc+Position-2)*2),Ord(TempStr[Position]),CursorAttr);
  478. End; {RefreshDisplay}
  479.  
  480. Procedure QueryExits;
  481. Var
  482.   StatusByte : Byte;
  483. Begin
  484. If CharIn = #13 then                { CR always exits }
  485.   Begin
  486.   Done      := True;
  487.   EnterData := 13;
  488.   With MG_Registers do
  489.     Begin
  490.     AX := 2 shl 8;
  491.     Intr($16,MG_Registers);
  492.     StatusByte := Lo(AX);
  493.     If (StatusByte and $04 > 0) then
  494.       Begin
  495.       EnterData := -13;
  496.       CtrlEmm   := True;
  497.       End;
  498.     End
  499.   End
  500. Else
  501.   If (Ord(CharIn) in Exits) then
  502.     Begin
  503.     Done      := True;
  504.     EnterData := Ord(CharIn);
  505.     End
  506.   Else
  507.     Begin
  508.     Beep;
  509.     CharIn := #255;
  510.     End;
  511. End;
  512.  
  513. Procedure CursorRight;
  514. Var
  515.   NewPos : Byte;
  516. Begin
  517. If ((Position = Len) and (Length(WorkStr) = Len)) then
  518.   Begin
  519.   Beep;
  520.   Exit;
  521.   End;
  522. NewPos := Position + 1;
  523. If NewPos <= (Length(WorkStr)+1) then
  524.   Position := NewPos
  525. Else
  526.   Beep;
  527. End; {CursorRight}
  528.  
  529. Procedure CursorLeft;
  530. Var
  531.   NewPos : Byte;
  532. Begin
  533. NewPos := Position - 1;
  534. If NewPos >= 1 then
  535.   Position := NewPos
  536. Else
  537.   Beep;
  538. End; {CursorLeft}
  539.  
  540. Procedure JumpRightWord;
  541. Var
  542.   I,WrkLen : Integer;
  543. Begin
  544. WrkLen := Length(WorkStr);
  545. If (not (VarTyp in ['B','I','R'])) then
  546.   If (Position < WrkLen) then
  547.     Begin
  548.     I := Position;
  549.     If (WorkStr[I] <> ' ') then
  550.       While ((I < WrkLen) and (WorkStr[I] <> ' ')) do
  551.         I := I + 1;
  552.     While ((I < WrkLen) and (WorkStr[I] = ' ')) do
  553.       I := I + 1;
  554.     Position := I;
  555.     End
  556.   Else
  557.     Beep
  558. Else
  559.   Beep;
  560. End; {JumpRightWord}
  561.  
  562. Procedure JumpLeftWord;
  563. Var
  564.   I,WrkLen : Integer;
  565. Begin
  566. If (not (VarTyp in ['B','I','R'])) then
  567.   If (Position > 1) then
  568.     Begin
  569.     I := Position - 1;
  570.     If (WorkStr[I] = ' ') then
  571.       While ((I > 1) and (WorkStr[I] = ' ')) do
  572.         I := I -1;
  573.     While (I > 1) and (WorkStr[I] <> ' ') do
  574.       I := I - 1;
  575.     Position := I;
  576.     If (I > 1) then
  577.       Position := I + 1;
  578.     End
  579. Else
  580.   Beep;
  581. End; {JumpLeftWord}
  582.  
  583. Procedure JumpRightField;
  584. Begin
  585. If Length(WorkStr) = Len then
  586.   If Position = Len then
  587.     Beep
  588.   Else
  589.     Position := Len
  590. Else
  591.   If Position = Length(WorkStr) + 1 then
  592.     Beep
  593.   Else
  594.     Position := Length(WorkStr) + 1;
  595. End;
  596.  
  597. Procedure RightJustify;
  598. Var
  599.   StatusByte : Byte;
  600. Begin
  601. With MG_Registers do
  602.   Begin
  603.   AX := 2 shl 8;
  604.   Intr($16,MG_Registers);
  605.   StatusByte := Lo(AX);
  606.   If (StatusByte and $04 > 0) then
  607.     Begin
  608.     QueryExits;
  609.     Exit;
  610.     End;
  611.   End;
  612. If (VarTyp in ['B','I','R']) then
  613.   Beep
  614. Else
  615.   If (Length(WorkStr) < Len) then
  616.     Begin
  617.     Position := 1;
  618.     While WorkStr[Length(WorkStr)] = ' ' do
  619.       Delete(WorkStr,Length(WorkStr),1);
  620.     While Length(WorkStr) < Len do
  621.       Begin
  622.       WorkStr  := Concat(' ',WorkStr);
  623.       Position := Position + 1;
  624.       End;
  625.     End;
  626. End; {RightJustify}
  627.  
  628. Procedure LeftJustify;
  629. Begin
  630. If (VarTyp in ['B','I','R']) then
  631.   Beep
  632. Else
  633.   Begin
  634.   While WorkStr[1] = ' ' do
  635.     Delete(WorkStr,1,1);
  636.   Position := 1;
  637.   End;
  638. End; {LeftJustify}
  639.  
  640. Procedure Change2UpperCase;
  641. Var
  642.   I : Integer;
  643. Begin
  644. If not (VarTyp in ['S','A']) then
  645.   Beep
  646. Else
  647.   For I := 1 to Length(WorkStr) do
  648.     If WorkStr[I] in ['a'..'z'] then
  649.       WorkStr[I] := Chr(Ord(WorkStr[I])-32);
  650. End; {Change2UpperCase}
  651.  
  652. Procedure Change2LowerCase;
  653. Var
  654.   I : Integer;
  655. Begin
  656. If not (VarTyp in ['S','A']) then
  657.   Beep
  658. Else
  659.   For I := 1 to Length(WorkStr) do
  660.     If WorkStr[I] in ['A'..'Z'] then
  661.       WorkStr[I] := Chr(Ord(WorkStr[I])+32);
  662. End; {Change2LowerCase}
  663.  
  664. Procedure AddACharacter;
  665. Var
  666.   NewPos : Integer;
  667. Begin
  668. If Position < Len then
  669.   NewPos := Position + 1
  670. Else
  671.   If Length(WorkStr) <> Len then
  672.     NewPos := Position
  673.   Else
  674.    Begin
  675.    Beep;
  676.    Exit;
  677.    End;
  678. If NewPos <= Len then
  679.   Begin
  680.   WorkStr  := Concat(WorkStr,CharIn);
  681.   If Position < Len then
  682.     Position := Position + 1;
  683.   If (VarTyp in ['S','A','U','L','N','D','X']) and
  684.      (Length(WorkStr) = Len)  then
  685.        Begin
  686.        Done      := True;
  687.        EnterData := 0;
  688.        End;
  689.   End;
  690. End; {AddACharacter}
  691.  
  692. Procedure ChangeACharacter;
  693. Begin
  694. WorkStr[Position] := CharIn;
  695. If (Position < Len) then
  696.   Position := Position + 1;
  697. End;
  698.  
  699. Procedure InsertACharacter;
  700. Begin
  701. If (Length(WorkStr) + 1) <= Len then
  702.   Begin
  703.   Insert(CharIn,WorkStr,Position);
  704.   Position := Position + 1;
  705.   End
  706. Else
  707.   Beep;
  708. End; {InsertACharacter}
  709.  
  710. Procedure DeleteACharacter;
  711. Begin
  712. If Length(WorkStr) > 0 then
  713.   Delete(WorkStr,Position,1)
  714. Else
  715.   Beep;
  716. End; {DeleteACharacter}
  717.  
  718. Procedure DestructiveBackspace;
  719. Begin
  720. If (Length(WorkStr) > 0)  and
  721.    (Position > 1)         then
  722.   Begin
  723.   Position := Position - 1;
  724.   Delete(WorkStr,Position,1);
  725.   End
  726. Else
  727.   Beep;
  728. End;
  729.  
  730. Function Initialized : Boolean;
  731. Begin
  732. Initialized := False;
  733. If VarTyp in ['B','I','R'] then
  734.   Begin
  735.   Case VarTyp of
  736.     'B' : Str(BytVar,WorkStr);
  737.     'I' : Str(IntVar,WorkStr);
  738.     'R' : Begin
  739.           Str(RealVar:Len:Decs,WorkStr);
  740.           While WorkStr[1] = ' ' do
  741.             Delete(WorkStr,1,1);
  742.           End;
  743.     End;
  744.   If Length(WorkStr) <= Len then
  745.     Begin
  746.     Initialized := True;
  747.     OrigStr     := WorkStr;
  748.     RefreshDisplay;
  749.     End;
  750.   End
  751. Else
  752.   If VarTyp in ['S','A','U','L','N','D','X'] then
  753.     Begin
  754.     WorkStr     := StrgVar;
  755.     Initialized := True;
  756.     OrigStr     := WorkStr;
  757.     RefreshDisplay;
  758.     End;
  759. End; {Initialized}
  760.  
  761. Procedure AssignValues;
  762. Var
  763.   RetnCode,WrkLen,TempInt  : Integer;
  764.   TempReal                 : Real;
  765.   ConvertStr               : MG_Str80;
  766.  
  767. Function Clean(NumericString:MG_Str80):MG_Str80;
  768. Begin
  769. While (Length(NumericString) > 0) and
  770.       (NumericString[1] = ' ') do
  771.   Delete(NumericString,1,1);
  772. While (Length(NumericString) > 0) and
  773.       (NumericString[Length(NumericString)] = ' ') do
  774.   Delete(NumericString,Length(NumericString),1);
  775. If (Length(NumericString) = 0) then
  776.   NumericString := ' ';
  777. Clean := NumericString;
  778. End; {Clean}
  779.  
  780. Procedure NumericFormat;
  781. Var
  782.   I,PLoc : Integer;
  783. Begin
  784. ConvertStr := Clean(ConvertStr);
  785. If (Pos('E',ConvertStr) > 0) then
  786.   Begin
  787.   While (Length(ConvertStr) < Len) do
  788.     ConvertStr := Concat(' ',ConvertStr);
  789.   WorkStr := ConvertStr;
  790.   RefreshDisplay;
  791.   Exit;
  792.   End;
  793. PLoc := Pos('.',ConvertStr);
  794. If PLoc = 0 then
  795.   I := Length(ConvertStr) + 1
  796. Else
  797.   I := PLoc;
  798. While I > 1 do
  799.   Begin
  800.   I := I - 3;
  801.   If I > 1 then
  802.     Insert(',',ConvertStr,I);
  803.   End;
  804. If Length(ConvertStr) <= Len then
  805.   Begin
  806.   While Length(ConvertStr) < Len do
  807.     ConvertStr := Concat(' ',ConvertStr);
  808.   WorkStr := ConvertStr;
  809.   RefreshDisplay;
  810.   End
  811. Else
  812.   Begin
  813.   While Length(WorkStr) < Len do
  814.     WorkStr := Concat(' ',WorkStr);
  815.   RefreshDisplay;
  816.   End;
  817. End; {NumericFormat}
  818.  
  819. Begin
  820. If ((Ord(CharIn) in Exits) or CtrlEmm) then
  821.   Begin
  822.   Converted := True;
  823.   WorkStr   := OrigStr;
  824.   RefreshDisplay;
  825.   Exit;
  826.   End;
  827. If VarTyp in ['B','I','R'] then
  828.   Begin
  829.   ConvertStr := WorkStr;
  830.   Case VarTyp of
  831.     'B' : Val(Clean(ConvertStr),TempInt,RetnCode);
  832.     'I' : Val(Clean(ConvertStr),TempInt,RetnCode);
  833.     'R' : Val(Clean(ConvertStr),TempReal,RetnCode);
  834.     End; {case}
  835.   If RetnCode = 0 then
  836.     Begin
  837.     Case VarTyp of
  838.       'B' : If (TempInt >= LowerByte) and (TempInt <= UpperByte) then
  839.               Begin
  840.               BytVar    := TempInt;
  841.               Converted := True;
  842.               End;
  843.       'I' : If (TempInt >= LowerInt) and (TempInt <= UpperInt) then
  844.               Begin
  845.               IntVar    := TempInt;
  846.               Converted := True;
  847.               End;
  848.       'R' : If (TempReal >= LowerReal) and (TempReal <= UpperReal) then
  849.               Begin
  850.               RealVar   := TempReal;
  851.               Converted := True;
  852.               End;
  853.       End; {case}
  854.     If Converted then
  855.       NumericFormat
  856.     Else
  857.       Begin
  858.       Done     := False;
  859.       Position := 1;
  860.       RefreshDisplay;
  861.       Beep;
  862.       End;
  863.     End
  864.   Else
  865.     Begin
  866.     Done     := False;
  867.     Position := RetnCode;
  868.     RefreshDisplay;
  869.     Beep;
  870.     End;
  871.   End
  872. Else
  873.   Begin
  874.   StrgVar   := WorkStr;
  875.   Converted := True;
  876.   RefreshDisplay;
  877.   End;
  878. End; {AssignValues}
  879.  
  880. Begin
  881. Done      := False;
  882. Converted := False;
  883. CtrlEmm   := False;
  884. Position  := 1;
  885. Case VarTyp of
  886.   'B','I'
  887.       : ValidChars := BytIntEdits;
  888.   'R' : ValidChars := RealEdits;
  889.   'S' : ValidChars := StrEditsAll;
  890.   'A' : ValidChars := Alpha;
  891.   'U' : ValidChars := UpperCase;
  892.   'L' : ValidChars := LowerCase;
  893.   'N' : ValidChars := Numeric;
  894.   'D' : ValidChars := Date;
  895.   'X' : ValidChars := Anything;
  896.   'M' : Begin
  897.         ValidChars := UserEditSet;
  898.         VarTyp     := 'X';
  899.         End;
  900. Else
  901.   Begin
  902.   EnterData := -1;
  903.   Exit;
  904.   End;
  905. End; {case}
  906. With MG_LastOpened do
  907.   Begin
  908.   XLoc := XLoc + X1;
  909.   YLoc := YLoc + Y1;
  910.   End;
  911. If not Initialized then
  912.   Begin
  913.   EnterData := -1;
  914.   Exit;
  915.   End;
  916. Repeat  {Data Conversion Loop}
  917.   Repeat  {Data Entry Loop}
  918.     Reset(kbd);
  919.     ScreenSaver(MG_TimeOut);
  920.     Read(kbd,CharIn);
  921.     If ClickOn then
  922.       MakeClickNoise;
  923.     If (CharIn = #27) and KeyPressed then
  924.       Begin
  925.       Read(kbd,CharIn); { If you are processing an extended scan code, then }
  926.       Case CharIn of          { translate is as a commands }
  927.         #77 : CharIn := ^D;      { Unshft RArr }
  928.         #75 : CharIn := ^S;      { Unshft LArr }
  929.         #116: CharIn := ^F;      { Ctrl'd RArr }
  930.         #115: CharIn := ^A;      { Ctrl'd LArr }
  931.         #82,#165
  932.             : CharIn := ^V;      { Ins : Unshft, Ctrl'd }
  933.         #83,#166
  934.             : CharIn := ^G;      { Del : Unshft, Ctrl'd }
  935.         #71 : Begin
  936.               If Position = 1 then
  937.                 Beep
  938.               Else
  939.                 Position := 1;
  940.               CharIn := #255;
  941.               End;
  942.         #79 : Begin              { UnShft End }
  943.               JumpRightField;
  944.               CharIn := #255;
  945.               End;
  946.         #15 : Begin
  947.               LeftJustify;
  948.               CharIn := #255;
  949.               End;
  950.                               { or process it as an exit - delete unused exits }
  951.         #59..#68,  #84..#93,
  952.         #94..#103, #104..#113    { All function keys }
  953.             : QueryExits;
  954.         #119,                    { Ctrl'd Home }
  955.         #117,                    { End  : Ctrl'd }
  956.         #73,#132,                { PgUp : Unshft, Ctrl'd }
  957.         #81,#118                 { PgDn : Unshft, Ctrl'd }
  958.             : QueryExits;
  959.         #72,#80                  { UArr, DArr : Unshft }
  960.             : QueryExits;
  961.         #3,#114,                 { Ctrl'd 2, Ctrl'd * }
  962.         #120..#131               { Alt'd 1..9,0,-,= }
  963.             : QueryExits;
  964.         #30,#48,#46,#32,#18,#33,#34,#35,#23,#36,#37,#38,#50,
  965.         #49,#24,#25,#16,#19,#31,#20,#22,#47,#17,#45,#21,#44
  966.             : QueryExits;        { Alt'd alphabetica, A..Z }
  967.       Else                    { or declare it to be invalid. }
  968.               CharIn := #00;
  969.         End; {case}
  970.       End;
  971.  
  972.     If CharIn in [#27,#13,#10] then  { other exits }
  973.       QueryExits;
  974.  
  975.     If not Done then      { If an exit has not been entered, }
  976.       Begin
  977.       Case VarTyp of
  978.         'U' : If CharIn in ['a'..'z'] then
  979.                 CharIn := Chr(Ord(CharIn)-32);
  980.         'L' : If CharIn in ['A'..'Z'] then
  981.                 CharIn := Chr(Ord(CharIn)+32);
  982.         End;
  983.       Case CharIn of                { Process CharIn as a command  }
  984.         ^D : CursorRight;
  985.         ^S : CursorLeft;
  986.         ^A : JumpLeftWord;
  987.         ^F : JumpRightWord;
  988.        #09 : RightJustify;          { Tab = #15 = ^I }
  989.         ^G : DeleteACharacter;
  990.         ^H,#127
  991.            : DestructiveBackspace;
  992.         ^B : ClickOn  := not ClickOn;
  993.         ^U : Change2UpperCase;
  994.         ^L : Change2LowerCase;
  995.         ^V : InsertOn := not InsertOn;
  996.         ^E : WorkStr  := Copy(WorkStr,1,(Position-1));
  997.         ^X : Begin
  998.              WorkStr  := '';
  999.              Position := 1;
  1000.              End;
  1001.         ^C,^K,^N,^O,^P,^Q,^R,^T,^W,^Y,^Z
  1002.            : QueryExits;
  1003.       Else                    { or as a normal character. }
  1004.         If (not (CharIn in ValidChars)) then
  1005.           If (CharIn <> #255) then
  1006.             Beep
  1007.           Else
  1008.         Else
  1009.           If InsertOn then
  1010.             If Position <= Length(WorkStr) then
  1011.               InsertACharacter
  1012.             Else
  1013.               AddACharacter
  1014.           Else
  1015.             If Position <= Length(WorkStr) then
  1016.               ChangeACharacter
  1017.             Else
  1018.               AddACharacter;
  1019.       End; {case}
  1020.     RefreshDisplay;
  1021.     End;
  1022.   Until Done;
  1023. AssignValues;
  1024. Until Converted;
  1025. End; {EnterData}
  1026.  
  1027. {*******************************************************************}
  1028.  
  1029. Function Menu(Window  : Byte;
  1030.                    S  : MG_Str255;
  1031.           Selections,NormAttr,ReverseAttr
  1032.                       : Byte;
  1033.                Exits  : MG_ExitsTyp) : Byte;
  1034. Var
  1035.   I,XLoc,YLoc,Block,Width : Integer;
  1036.                        Ch : Char;
  1037.  
  1038. Procedure WriteSelections(XLoc,YLoc:Byte);
  1039. Var
  1040.   InitialAttr : Byte;
  1041. Begin
  1042. For I := 1 to Selections do
  1043.   Begin
  1044.   InitialAttr := NormAttr;
  1045.   If I = 1 then
  1046.     InitialAttr := ReverseAttr;
  1047.   Rite(Copy(S,1,(Pos('\',S)-1)),XLoc,(YLoc+I-1),InitialAttr);
  1048.   Delete(S,1,Pos('\',S));
  1049.   End;
  1050. End; {WriteSelections}
  1051.  
  1052. Procedure ReverseBG(X,Y:Byte;Attr:Integer);
  1053. Var
  1054.   Loc : Integer;
  1055. Begin
  1056. Attr := Attr shl 8;
  1057. For I := 1 to Width do
  1058.   Begin
  1059.   Loc := (Y-1)*160+(X+I-2)*2;
  1060.   MemW[Seg(MG_PhysicalScreen^):Loc] := Attr or Lo(MemW[Seg(MG_PhysicalScreen^):Loc]);
  1061.   End;
  1062. End; {ReverseBG}
  1063.  
  1064. Procedure MakeSelections;
  1065. Begin
  1066. Block := 1;
  1067. Repeat
  1068.   ScreenSaver(MG_TimeOut);
  1069.   Read(kbd,Ch);
  1070.   If KeyPressed then
  1071.     Begin
  1072.     Read(kbd,Ch);
  1073.     If (Ord(Ch) = 72) and (Block > 1) then
  1074.       Begin                                      { 72 : Unshft Up Arrow }
  1075.       ReverseBg(XLoc,(YLoc+Block-1),NormAttr);
  1076.       Block := Block - 1;
  1077.       ReverseBG(XLoc,(YLoc+Block-1),ReverseAttr);
  1078.       End
  1079.     Else
  1080.       If (Ord(Ch) = 80) and (Block < (Selections)) then
  1081.         Begin                                    { 80 : Unshft Down Arrow }
  1082.         ReverseBg(XLoc,(YLoc+Block-1),NormAttr);
  1083.         Block := Block + 1;
  1084.         ReverseBG(XLoc,(YLoc+Block-1),ReverseAttr);
  1085.         End;
  1086.     End;
  1087. Until (Ord(Ch) in [13,27]) or (Ord(Ch) in Exits);
  1088. If Ord(Ch) = 27 then
  1089.   Menu := 0
  1090. Else
  1091.   If Ord(Ch) in Exits then
  1092.     Menu := Ord(Ch)
  1093.   Else
  1094.     Menu := Block;
  1095. End; {MakeSelections}
  1096.  
  1097. Begin
  1098. OpenWindow(Window);
  1099. With MG_LastOpened do
  1100.   Begin
  1101.   XLoc  := X1 + 1;
  1102.   YLoc  := Y1 + 1;
  1103.   Width := X2 - X1 -1;
  1104.   End;
  1105. If not MG_RiteFlag[Window] then
  1106.   WriteSelections(XLoc,YLoc);
  1107. MakeSelections;
  1108. CloseWindow;
  1109. End; {Menu}